home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Extensions / html.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-06-16  |  5.7 KB  |  197 lines
  1. /*
  2.  *
  3.  * h t m l . c            -- Html support for STk
  4.  *
  5.  * Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  6.  * 
  7.  *
  8.  * Permission to use, copy, and/or distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that both the above copyright notice and this permission notice appear in
  11.  * all copies and derived works.  Fees for distribution or use of this
  12.  * software or derived works may only be charged with express written
  13.  * permission of the copyright holder.  
  14.  * This software is provided ``as is'' without express or implied warranty.
  15.  *
  16.  *
  17.  *
  18.  *           Author: Erick Gallesio [eg@kaolin.unice.fr]
  19.  *    Creation date:  1-Sep-1995 23:10
  20.  * Last file update: 16-Jun-1996 20:47
  21.  */
  22.  
  23. #include <ctype.h>
  24. #include "stk.h"
  25. struct char_type {
  26.   char *name;
  27.   unsigned char c;
  28. };
  29.  
  30. static struct char_type table [] = {
  31.   {"lt",        '<'},       {"gt",        '>'},    {"amp",    '&'},  
  32.   {"quot",    '"'},    
  33.   {"nbsp",    '\xa0'}, {"iexcl",    '\xa1'}, {"cent",    '\xa2'}, 
  34.   {"pound",    '\xa3'}, {"curren",    '\xa4'}, {"yen",    '\xa5'},
  35.   {"brvbar",    '\xa6'}, {"sect",    '\xa7'}, {"uml",    '\xa8'},
  36.   {"copy",    '\xa9'}, {"ordf",    '\xaa'}, {"laquo",    '\xab'},
  37.   {"not",    '\xac'}, {"shy",    '\xad'}, {"reg",    '\xae'},
  38.   {"hibar",    '\xaf'}, {"deg",    '\xb0'}, {"plusmn",    '\xb1'},
  39.   {"sup2",    '\xb2'}, {"sup3",    '\xb3'}, {"acute",    '\xb4'},
  40.   {"micro",    '\xb5'}, {"para",    '\xb6'}, {"middot",    '\xb7'},
  41.   {"cedil",    '\xb8'}, {"sup1",    '\xb9'}, {"ordm",    '\xba'},
  42.   {"raquo",    '\xbb'}, {"frac14",    '\xbc'}, {"frac12",    '\xbd'},
  43.   {"frac34",    '\xbe'}, {"iquest",    '\xbf'}, {"Agrave",    '\xc0'},
  44.   {"Aacute",    '\xc1'}, {"Acirc",    '\xc2'}, {"Atilde",    '\xc3'},
  45.   {"Auml",    '\xc4'}, {"Aring",    '\xc5'}, {"AElig",    '\xc6'},
  46.   {"Ccedil",    '\xc7'}, {"Egrave",    '\xc8'}, {"Eacute",    '\xc9'},
  47.   {"Ecirc",    '\xca'}, {"Euml",    '\xcb'}, {"Igrave",    '\xcc'},
  48.   {"Iacute",    '\xcd'}, {"Icirc",    '\xce'}, {"Iuml",    '\xcf'},
  49.   {"ETH",    '\xd0'}, {"Ntilde",    '\xd1'}, {"Ograve",    '\xd2'},
  50.   {"Oacute",    '\xd3'}, {"Ocirc",    '\xd4'}, {"Otilde",    '\xd5'},
  51.   {"Ouml",    '\xd6'}, {"times",    '\xd7'}, {"Oslash",    '\xd8'},
  52.   {"Ugrave",    '\xd9'}, {"Uacute",    '\xda'}, {"Ucirc",    '\xdb'},
  53.   {"Uuml",    '\xdc'}, {"Yacute",    '\xdd'}, {"THORN",    '\xde'},
  54.   {"szlig",    '\xdf'}, {"agrave",    '\xe0'}, {"aacute",    '\xe1'},
  55.   {"acirc",    '\xe2'}, {"atilde",    '\xe3'}, {"auml",    '\xe4'},
  56.   {"aring",    '\xe5'}, {"aelig",    '\xe6'}, {"ccedil",    '\xe7'},
  57.   {"egrave",    '\xe8'}, {"eacute",    '\xe9'}, {"ecirc",    '\xea'},
  58.   {"euml",    '\xeb'}, {"igrave",    '\xec'}, {"iacute",    '\xed'},
  59.   {"icirc",    '\xee'}, {"iuml",    '\xef'}, {"eth",    '\xf0'},
  60.   {"ntilde",    '\xf1'}, {"ograve",    '\xf2'}, {"oacute",    '\xf3'},
  61.   {"ocirc",    '\xf4'}, {"otilde",    '\xf5'}, {"ouml",    '\xf6'},
  62.   {"divide",    '\xf7'}, {"oslash",    '\xf8'}, {"ugrave",    '\xf9'},
  63.   {"uacute",    '\xfa'}, {"ucirc",    '\xfb'}, {"uuml",    '\xfc'},
  64.   {"yacute",    '\xfd'}, {"thorn",    '\xfe'}, {"yuml",    '\xff'},
  65.   {"", 0}};
  66.  
  67. static void skip_spaces(FILE *f)
  68. {
  69.     int    c;
  70.  
  71.     for (;;) {
  72.       c = Getc(f);
  73.       if (c == EOF) break;
  74.       if (!isspace(c)) {
  75.     Ungetc(c, f);
  76.     break;
  77.       }
  78.     }
  79. }
  80.     
  81. static PRIMITIVE STk_html_next_token(SCM iport)
  82. {
  83.   /* Return next HTML token */
  84.   char ch, *t, token[256];
  85.   int c;
  86.   Tcl_DString dStr1, dStr2;
  87.   SCM z;
  88.   FILE *f;
  89.  
  90.   if (!INP(iport)) Err("%Html:next-token: bad port", iport);
  91.  
  92.   f = PORT_FILE(iport);
  93.  
  94.   if (Eof(f) || ((c = Getc(f)) == EOF)) return STk_eof_object;
  95.  
  96.   Tcl_DStringInit(&dStr1);   Tcl_DStringInit(&dStr2);
  97.   
  98.   if (c == '<') {
  99.     skip_spaces(f);
  100.     while ((c = Getc(f)) != EOF && (c != '>') && (c != ' ') && (c != '\t')) {
  101.       ch = tolower(c);
  102.       Tcl_DStringAppend(&dStr1, &ch, 1);
  103.     } 
  104.     if (c == ' ' || c == '\t') {
  105.       /* Read the argument */
  106.       skip_spaces(f);
  107.       while ((c = Getc(f)) != EOF && (c != '>')) {
  108.     ch = c;
  109.     Tcl_DStringAppend(&dStr2, &ch, 1);
  110.       } 
  111.     }
  112.     
  113.     if (Tcl_DStringValue(&dStr1)[0] == '\0') 
  114.       z = STk_makestring("<>");
  115.     else 
  116.       if (Tcl_DStringValue(&dStr1)[0]=='/' && Tcl_DStringValue(&dStr1)[1] == '\0')
  117.     z = STk_makestring("</>"); 
  118.       else
  119.     z = Cons(STk_makestring(Tcl_DStringValue(&dStr1)),
  120.          STk_makestring(Tcl_DStringValue(&dStr2)));
  121.   }
  122.   else {
  123.     if (c == '&') {
  124.       t = token;
  125.       while ((c = Getc(f)) != EOF && c != ';' && isalpha(c)) *t++ = c;
  126.       *t = 0;
  127.       
  128.       if (c != ';') Ungetc(c, f);
  129.       
  130.       /* Search the given token in the translation table */
  131.       {
  132.     int i;
  133.  
  134.     for (i = 0; table[i].c; i++)
  135.       if (strcmp(token, table[i].name) == 0) {
  136.         Tcl_DStringAppend(&dStr1, &table[i].c, 1);
  137.         break;
  138.       }
  139.     if (!table[i].c)  /* Not found */ Tcl_DStringAppend(&dStr1, token, -1);
  140.       }
  141.     } 
  142.     else {
  143.       do {
  144.     if (c == '<' || c == '&') {
  145.       Ungetc(c, f);
  146.       break;
  147.     }
  148.     ch = c;
  149.     Tcl_DStringAppend(&dStr1, &ch, 1);
  150.       } 
  151.       while ((c = Getc(f)) != EOF);
  152.     }
  153.     z = STk_makestring(Tcl_DStringValue(&dStr1));
  154.   }
  155.  
  156.   Tcl_DStringFree(&dStr1); Tcl_DStringFree(&dStr2);
  157.   return z;
  158. }
  159.  
  160.  
  161. static PRIMITIVE STk_html_clean_spaces(SCM str, SCM ignore_spaces)
  162. {
  163.   Tcl_DString dString;
  164.   char c, *s;
  165.   int only_spaces = TRUE;
  166.   SCM z;
  167.   
  168.   if (!STRINGP(str)) Err("%html:clean-spaces: bad string", str);
  169.  
  170.   Tcl_DStringInit(&dString);
  171.   for (s = CHARS(str); c = *s; s++) {
  172.     if (c == ' ' || c == '\n' || c == '\t' || c == '\r') {
  173.       if (ignore_spaces == Ntruth) {
  174.     Tcl_DStringAppend(&dString, " ", 1);
  175.     ignore_spaces = Truth;
  176.       }
  177.     }
  178.     else {
  179.       Tcl_DStringAppend(&dString, &c, 1);
  180.       only_spaces = FALSE;
  181.       ignore_spaces = Ntruth;
  182.     }
  183.   }
  184.   z = Cons(STk_makestring(Tcl_DStringValue(&dString)),
  185.        only_spaces ? Truth: Ntruth);
  186.   Tcl_DStringFree(&dString);
  187.  
  188.   return z;
  189. }
  190.  
  191. PRIMITIVE STk_init_html(void)
  192. {
  193.   STk_add_new_primitive("%html:clean-spaces",  tc_subr_2,  STk_html_clean_spaces);
  194.   STk_add_new_primitive("%html:next-token",    tc_subr_1,  STk_html_next_token);
  195.   return UNDEFINED;
  196. }
  197.